home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DISK_UTL / TESTDR / TESTDRIV.PAS
Pascal/Delphi Source File  |  1995-02-25  |  5KB  |  190 lines
  1. { ###################################################################
  2.  
  3.     Extends the Windows function GetDriveType()
  4.     and provides the same function for Dos...
  5.  
  6.     This code by: K Campbell CompuServe [100064,1751]
  7.  
  8.     Some sections hacked out of code by:
  9.  
  10.         Dr. Peter Below CIS [100113.1101]
  11.  
  12.     &
  13.  
  14.         Extended GetDriveType for Windows 3.0/3.1.
  15.         Code ported from the C in Microsoft PSS document Q105922.
  16.         by    Doug Wegscheid 3/22/94.
  17.  
  18.     No warrenties given! (Don't blame them, blame me.)
  19.  
  20.     Note:
  21.  
  22.     1)        this uses the convention: Drive 1 = A and not Drive 0 = A
  23.             which the original GetDriveType() uses!!!
  24.  
  25.     2)        works OK with CDRoms and RAMDisks, but I can't test on a
  26.             network (as I'm not on one!) If you use it on a networked
  27.             drive or a removable drive, let me know if it works!
  28.  
  29.     This code is released to the public domain!
  30. ################################################################### }
  31.  
  32. unit TestDrive;
  33.  
  34. interface
  35.  
  36. {$IFDEF WINDOWS}
  37. uses    WinProcs, WinDos, Strings;
  38.  
  39. {$ELSE}
  40. uses    Dos, Strings;
  41.  
  42. {$ENDIF}
  43.  
  44. const    dt_NotFound        = 0;             { Not detected }
  45.         dt_Removable    = 1;        { Unknown removable type }
  46.         dt_HardDisk    = 2;        { Standard hard disk }
  47.         dt_Networked    = 3;        { Remote drive on a network }
  48.         dt_CDRom             = 4;        { CD Rom drive }
  49.         dt_Floppy         = 5;        { Floppy drive }
  50.         dt_RAMDisk        = 6;        { RAM disk }
  51.  
  52. type    DeviceParams = record
  53.             bSpecFunc    : byte;            { Special functions }
  54.             bDevType    : byte;                { Device type }
  55.             wDevAttr    : word;             { Device attributes }
  56.             wCylinders    : word;            { Number of cylinders }
  57.             bMediaType    : byte;            { Media type }
  58.                                                 { Beginning of BIOS parameter block (BPB) }
  59.             wBytesPerSec    : word;        { Bytes per sector }
  60.             bSecPerClust    : byte;        { Sectors per cluster }
  61.             wResSectors    : word;         { Number of reserved sectors }
  62.             bFATs        : byte;            { Number of FATs }
  63.             wRootDirEnts    : word;      { Number of root-directory entries }
  64.             wSectors    : word;            { Total number of sectors }
  65.             bMedia    : byte;            { Media descriptor }
  66.             wFATsecs    : word;            { Number of sectors per FAT }
  67.             wSecPerTrack    : word;      { Number of sectors per track }
  68.             wHeads    : word;            { Number of heads }
  69.             dwHiddenSecs    : longint;  { Number of hidden sectors }
  70.             dwHugeSectors    : longint;  { Number of sectors if wSectors == 0 }
  71.                                                 { End of BIOS parameter block (BPB) }
  72.         end;
  73.  
  74. function GetDeviceParameters(Drive : word ; var dp : DeviceParams) : boolean;
  75. function GetDriveTypeEx(D : byte) : byte;
  76. function IsCDRomDrive(D : Byte) : boolean;
  77.  
  78. implementation
  79.  
  80.  
  81. function GetDeviceParameters(Drive : word ; var dp : DeviceParams) : boolean;
  82.  
  83. {$IFDEF WINDOWS}
  84. var Reg : TRegisters;
  85.  
  86. {$ELSE}
  87. var Reg : Registers;
  88.  
  89. {$ENDIF}
  90.  
  91. begin
  92.     FillChar(Reg, SizeOf(Reg), #0);            { clean up registers to avoid GPF }
  93.     Reg.ax := $440D;                                { IOCTL }
  94.     Reg.ch := $08;                                    { block device }
  95.     Reg.cl := $60;                                    { get device parameters }
  96.     Reg.bx := Drive;                                { 1 = A:, 2 = B:, etc... }
  97.     Reg.ds := seg(dp);
  98.     Reg.dx := ofs(dp);
  99.     MSDos(Reg);
  100.     GetDeviceParameters := (Reg.flags and fCarry) = 0
  101. end;
  102.  
  103.  
  104. function GetDriveTypeEx(D : byte) : byte;
  105.  
  106. {$IFNDEF WINDOWS}
  107. var    Reg : Registers;
  108.  
  109. {$ENDIF}
  110.  
  111. var   Result, uType : byte;
  112.         dp    : DeviceParams;
  113.  
  114. begin
  115.     Result := dt_NotFound;
  116.     FillChar (dp, SizeOf(dp), #0);    { clear the DPB }
  117.  
  118. {$IFDEF WINDOWS}
  119.     uType := GetDriveType(D - 1);        { make a rough guess }
  120.  
  121. {$ELSE}
  122.     uType := 0;
  123.     FillChar(Reg, SizeOf(Reg), #0);
  124.     Reg.ax := $4408;                              { IOCTL is drive changeable function }
  125.     Reg.bl := D;
  126.     MSDos(Reg);
  127.     if (fCarry and Reg.Flags) <> 0 then
  128.     { error, check error code in ax }
  129.     begin
  130.         { Driver does not support this call, so guess as a hard disk }
  131.         if Reg.ax = 1 then uType := 3;
  132.     end
  133.     else
  134.     begin
  135.         if Reg.ax = 0 then                        { media changeable, floppy, WORM or MO }
  136.             uType := 2
  137.         else                                      { else hard disk, ramdisk or CD-ROM }
  138.             uType := 3;
  139.     end;
  140.     { check if drive is remote }
  141.     Reg.ax := $4409;                              { IOCTL is redirected device function }
  142.     Reg.bl := D;
  143.     MSDos(Reg);
  144.     if (not ((fCarry and Reg.Flags) <> 0)) and (Reg.dx = $1000) then uType := 4;
  145.  
  146. {$ENDIF}
  147.     case uType of
  148.         2 :    { Removable }
  149.             {    0=320/360kb floppy, 1=1.2Mb, 2=720kb, 3=8" single density,
  150.                 4=8" double density, 7=1.44Mb, 8=optical, 9=2.88Mb.}
  151.             if GetDeviceParameters(D, dp) and (dp.bDevType in [0..4,7,9]) then
  152.                 Result := dt_Floppy
  153.             else
  154.                 Result := dt_Removable;
  155.         3 :    { Fixed }
  156.             if GetDeviceParameters(D, dp) and (dp.bDevType = 5) then
  157.                 Result := dt_HardDisk
  158.             else
  159.                 Result := dt_RAMDisk;
  160.         4 :   { Remote }
  161.             if IsCDRomDrive(D) then
  162.                 Result := dt_CDRom
  163.             else
  164.                 Result := dt_Networked;
  165.     end;
  166.     GetDriveTypeEx := Result;
  167. end;
  168.  
  169.  
  170. { Returns TRUE if Drive is a CD-ROM drive, FALSE if it isn't.}
  171. function IsCDRomDrive(D : Byte) : boolean;
  172.  
  173. {$IFDEF WINDOWS}
  174. var Reg : TRegisters;
  175.  
  176. {$ELSE}
  177. var Reg : Registers;
  178.  
  179. {$ENDIF}
  180.  
  181. begin
  182.     FillChar(Reg, SizeOf(Reg), #0);
  183.     Reg.ax := $150B;            { MSCDEX installation check }
  184.     Reg.cx := (D - 1);        { D: 1 = A:, 2 = B:, etc... }
  185.     Intr ($2F, Reg);            { do it }
  186.     IsCDRomDrive := (Reg.bx = $ADAD) and (Reg.ax <> 0);
  187. end;
  188.  
  189.  
  190. end.